home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / gjr / cmplrtst.lha / tail.scm < prev    next >
Encoding:
Text File  |  1990-03-27  |  758 b   |  35 lines
  1. ;;; -*- Scheme -*-
  2.  
  3. #|
  4. Description:
  5. This code tests tail recursion and dynamic links.
  6.  
  7. Usage:
  8. (go) -> infinite loop printing a
  9. |#
  10.  
  11. (declare (usual-integrations))
  12.  
  13. (define (go)
  14.   (define (atom? x)
  15.     (not (pair? x)))
  16.  
  17.   (define (flat-apply f original)
  18.     (define (flatten-1 l add-to-what)
  19.       (if (atom? l)
  20.       (f l add-to-what)
  21.       (flatten-1 (car l) (flatten-2 (cdr l) add-to-what))))
  22.  
  23.     (define (flatten-2 l add-to-what)
  24.       (cond ((null? l) add-to-what)
  25.         ((atom? l) (error "Flatten: Bad list" original))
  26.         (else (flatten-1 (car l) (flatten-2 (cdr l) add-to-what)))))
  27.  
  28.     (flatten-2 original '()))
  29.  
  30.   (define (test-f element a-list)
  31.     (newline)
  32.     (write element)
  33.     (flat-apply test-f (cons element a-list)))
  34.  
  35.   (flat-apply test-f '(a)))